SGI Freeware 2002 November/SGI Freeware 2002 November - Disc 1.iso/dist/fw_exmh.idb/usr/freeware/lib/exmh-2.5/PgpDecryptExpect.z/PgpDecryptExpect

Text File | 2002-07-08 | 5KB | 184 lines

# -*-Mode: tcl;-*-
#
# To be interpreted by expectk
#
#
# This is run by exmh, currenly only when decrypting certain PGP messages.
# See Preferences->Pgp->Help or the source code for more information.
#
# Arguments: v, infile, outfile, exmh-bg name

wm withdraw .

if {[llength $argv] < 4} {
    puts "PgpDecryptExpect should be invoked by exmh"
    exit 1
}

set v [lindex $argv 0]
set infile [lindex $argv 1]
set outfile [lindex $argv 2]
set exmhbg [lindex [lrange $argv 3 [expr [llength $argv] - 1]] 0]
set badpass 0
set encrypted 0

# GetPassword tries (if necessary) to get the the pass phrase using
# Exmh's Misc_GetPass command.  It sets pgpPass if it gets a
# legitamite password.

proc GetPassword { key } {
    global spawn_id expect_out badpass v

    if {[string match conventional $key]} {
    set password [Exmh [list Pgp_Misc_GetPass $v \
                        "Enter [Exmh [list set pgp($v,fullName)]] Password" \
            "symmetric encryption - enter pass phrase"] ]
    } else {
    Match_PrivateExact $key keyid keydesc

    if $badpass {
        Exmh [list unset pgp($v,pass,$keyid)]
    }

    if {$keyid!={} && [Exmh [list info exists pgp($v,pass,$keyid)]]} {
        set password [Exmh [list set pgp($v,pass,$keyid)]]
    } else {
        set password [Exmh [list Pgp_Misc_GetPass $v \
                        "Enter [Exmh [list set pgp($v,fullName)]] Password" \
                        "password for $keydesc"] ]
            Exmh [list set pgp($v,pass,$keyid) $password]
    }
    set badpass 1
    }

    exp_send "${password}\r"
    InterpretResponse
}

# search privatekeys for the keyid exactly matching keydesc
# returns keyid or {}
proc Match_PrivateExact { key keyidVar keydescVar } {
    global v
    upvar $keyidVar keyid
    upvar $keydescVar keydesc

    foreach elem [Exmh [list set pgp($v,privatekeys)]] {
        # One key keys (main only)
        set hexid [lindex $elem 0]
        if {[regexp $key $hexid]} {
            Debug "<Match_PrivateExact> $hexid"
            set keyid $hexid
            set keydesc [lindex $elem 4]
            return
        }
        # Double key keys (main and sub)
        set hexid [lindex $elem 2]
        if {[regexp $key $hexid]} {
            Debug "<Match_PrivateExact> $hexid"
            set keyid $hexid
            set keydesc [lindex $elem 4]
            return
        }
    }
    set keyid {}
    set keydesc $key
}

# Saves typing - this calls the given Exmh command.
proc Exmh {cmd} {
    global exmhbg
    send $exmhbg $cmd
}

proc Debug {text} {
#    send exmh [concat Exmh_Debug [list $text]]
    if {![catch {open /home/markus/***exmh***/dlog {APPEND WRONLY}} fd]} {
        puts $fd $text
        close $fd
    }
}

proc InterpretResponse { } {
    global spawn_id timeout expect_out badpass encrypted v

    expect {
    [Exmh [list set pgp($v,expectpat,passprompt)]] {
            if {[info exists expect_out(1,string)]} {
            GetPassword $expect_out(1,string)
            } else {
                # There was no keyid and the program is prompting for a password?
                # It must be conventional encryption then. I hope this hasn't
                # unforeseen effects
                set encrypted 1
                GetPassword conventional
            }
    }
    -re [Exmh [list set pgp($v,expectpat,conventional)]] {
        set encrypted 1
        set expect_out(1,string) conventional
        InterpretResponse
    }
        -re [Exmh [list set pgp($v,expectpat,publickey)]] {
            # I hope 40 is enough on slow computers
            set timeout 40
            set badpass 0
            set encrypted 1
            InterpretResponse
        }
    -re [Exmh [list set pgp($v,expectpat,secretmissing)]] {
        set encrypted 1
        catch {regsub -all \r $expect_out(1,string)$expect_out(2,string) {} msg}
        Done $msg 1
    }
    -re [Exmh [list set pgp($v,expectpat,nopgpfile)]] {
        Done $expect_out(1,string) 2
    }
    eof {
            Debug Eof
        regsub -all \r $expect_out(buffer) {} msg
        Done [string trim $msg]
    }
    }
    Debug Error
    Done "Unknown Error" 2
}

# Done is the procedure that calls the Exmh continuation command
# before this process exits.
proc Done {msg {error 0} } {
    global outfile infile encrypted

    if !$encrypted {
    set msg "Note: File may not have been encrypted.\n\n$msg"
    }

    if {$error==2} {
    set msg "Error processing with PGP\n$msg"
    }

    if {[string trim $msg]==""} {
    set msg "Message encrypted with PGP"
    }
    Exmh [list set pgpmsg $msg]
    puts $msg
    exit $error
}

expect_after timeout {
    Done "Unknown Error" 2
}
set timeout 4

# Now execute the whole thing
eval [concat spawn -nottycopy -noecho [Exmh [list set pgp($v,cmd_DecryptExpect)]]]

# Don't ask me why, but when I comment out the following line my
# program ceases to work under some conditions.  Mail me
# <[e-mail]> if you figure it out.
expect -re . {}

catch {InterpretResponse} error
Debug $error

exit 3